home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / cnstrnts / thinglab.lha / ThingLabII / Demos.v2.st next >
Text File  |  1993-07-24  |  40KB  |  1,366 lines

  1. Object subclass: #RodsDemo
  2.     instanceVariableNames: 'thing '
  3.     classVariableNames: ''
  4.     poolDictionaries: ''
  5.     category: 'TLII-Demos'!
  6. RodsDemo comment:
  7. 'This demo shows how history variables may be used to simulate a physical system evolving through time. In this example, we create a three-segment "snake" of semi-rigid rods. The rods try to keep themselves a constant length.'!
  8.  
  9.  
  10. !RodsDemo methodsFor: 'public'!
  11.  
  12. makeDemo
  13.     "RodsDemo new makeDemo"
  14.  
  15.     self buildThing.
  16.     self addConstraints.
  17.  
  18.     ThingConstructorView openOn: thing.! !
  19.  
  20. !RodsDemo methodsFor: 'private'!
  21.  
  22. addConstraints
  23.     "Add force constraints to the new Thing. RodThings already compute the force vector on each endpoints. If the rod is compressed, this force is outward and if the rod is compressed the force is inward. Try changing the constant multiplier of 'force' in these equations to something higher; if it is too high the system will oscillate like a spring, even though we are not modeling mass and momentum, because the difference equations become unstable. Try it!!"
  24.  
  25.     thing methods: #(
  26.         'newP _ oldP + (force * 0.3)')
  27.         where: #((newP rod1.p1.value)
  28.                  (oldP rod1.p1.last)
  29.                  (force rod1.p1Force.last))
  30.         strength: #default.
  31.  
  32.     thing methods: #(
  33.         'newP _ oldP + (force * 0.3)')
  34.         where: #((newP rod3.p2.value)
  35.                  (oldP rod3.p2.last)
  36.                  (force rod3.p2Force.last))
  37.         strength: #default.
  38.  
  39.     thing methods: #(
  40.         'newP _ oldP + ((force1 + force2) * 0.3)')
  41.         where: #(
  42.             (newP rod2.p2.value)
  43.             (oldP rod2.p2.last)
  44.             (force1 rod1.p2Force.last)
  45.             (force2 rod2.p2Force.last))
  46.         strength: #default.
  47.  
  48.     thing methods: #(
  49.         'newP _ oldP + ((force1 + force2) * 0.3)')
  50.         where: #(
  51.             (newP rod2.p1.value)
  52.             (oldP rod2.p1.last)
  53.             (force1 rod2.p1Force.last)
  54.             (force2 rod3.p1Force.last))
  55.         strength: #default.!
  56.  
  57. buildThing
  58.     "Build a Thing consisting of three RodThings connected as follows:
  59.         p1 - rod1 - p2/p2 - rod2 - p1/p1 - rod3 - p2"
  60.  
  61.     thing _ Thing defineNewThing.
  62.     thing addPartsNamed: #(rod1 rod2 rod3)
  63.           toHold: (Array
  64.             with: RodThing new
  65.             with: RodThing new
  66.             with: RodThing new).
  67.  
  68.     thing merge: #rod1.line.p2 with: #rod2.line.p2.
  69.     thing merge: #rod2.line.p1 with: #rod3.line.p1.! !
  70. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  71.  
  72. RodsDemo class
  73.     instanceVariableNames: ''!
  74.  
  75.  
  76. Object subclass: #QuadrilateralDemo
  77.     instanceVariableNames: 'thing '
  78.     classVariableNames: ''
  79.     poolDictionaries: ''
  80.     category: 'TLII-Demos'!
  81. QuadrilateralDemo comment:
  82. 'This demo builds a four-level deep quadrilateral object. This is somewhat of a classic from the original ThingLab.'!
  83.  
  84.  
  85. !QuadrilateralDemo methodsFor: 'public'!
  86.  
  87. makeDemo
  88.     "QuadrilateralDemo new makeDemo"
  89.  
  90.     self buildThing.
  91.     self doMerges.
  92.     self addMidPointConstraints.
  93.     self addStays.
  94.     self initializeParts.
  95.  
  96.     ThingConstructorView openOn: thing.! !
  97.  
  98. !QuadrilateralDemo methodsFor: 'private'!
  99.  
  100. addMidPointConstraints
  101.     "Add 12 midpoint constraints for the x's and another 12 for the y's."
  102.  
  103.     | mp |
  104.     mp _ Constraint
  105.         symbols: #(p1 midPoint p2)
  106.         methodStrings: #(
  107.             'midPoint _ (p1 + p2) // 2'
  108.             'p1 _ (2 * midPoint - p2) rounded'
  109.             'p2 _ (2 * midPoint - p1) rounded').
  110.     thing addConstraint:
  111.         (mp clone bind: (Array
  112.             with: thing->#p1.x
  113.             with: thing->#p5.x
  114.             with: thing->#p2.x)
  115.          strength: #strongPreferred).
  116.     thing addConstraint:
  117.         (mp clone bind: (Array
  118.             with: thing->#p2.x
  119.             with: thing->#p6.x
  120.             with: thing->#p3.x)
  121.          strength: #strongPreferred).
  122.     thing addConstraint:
  123.         (mp clone bind: (Array
  124.             with: thing->#p3.x
  125.             with: thing->#p7.x
  126.             with: thing->#p4.x)
  127.          strength: #strongPreferred).
  128.     thing addConstraint:
  129.         (mp clone bind: (Array
  130.             with: thing->#p4.x
  131.             with: thing->#p8.x
  132.             with: thing->#p1.x)
  133.          strength: #strongPreferred).
  134.  
  135.     thing addConstraint:
  136.         (mp clone bind: (Array
  137.             with: thing->#p5.x
  138.             with: thing->#p10.x
  139.             with: thing->#p6.x)
  140.          strength: #strongPreferred).
  141.     thing addConstraint:
  142.         (mp clone bind: (Array
  143.             with: thing->#p6.x
  144.             with: thing->#p11.x
  145.             with: thing->#p7.x)
  146.          strength: #strongPreferred).
  147.     thing addConstraint:
  148.         (mp clone bind: (Array
  149.             with: thing->#p7.x
  150.             with: thing->#p12.x
  151.             with: thing->#p8.x)
  152.          strength: #strongPreferred).
  153.     thing addConstraint:
  154.         (mp clone bind: (Array
  155.             with: thing->#p8.x
  156.             with: thing->#p9.x
  157.             with: thing->#p5.x)
  158.          strength: #strongPreferred).
  159.  
  160.     thing addConstraint:
  161.         (mp clone bind: (Array
  162.             with: thing->#p9.x
  163.             with: thing->#p13.x
  164.             with: thing->#p10.x)
  165.          strength: #strongPreferred).
  166.     thing addConstraint:
  167.         (mp clone bind: (Array
  168.             with: thing->#p10.x
  169.             with: thing->#p14.x
  170.             with: thing->#p11.x)
  171.          strength: #strongPreferred).
  172.     thing addConstraint:
  173.         (mp clone bind: (Array
  174.             with: thing->#p11.x
  175.             with: thing->#p15.x
  176.             with: thing->#p12.x)
  177.          strength: #strongPreferred).
  178.     thing addConstraint:
  179.         (mp clone bind: (Array
  180.             with: thing->#p12.x
  181.             with: thing->#p16.x
  182.             with: thing->#p9.x)
  183.          strength: #strongPreferred).
  184.  
  185.     thing addConstraint:
  186.         (mp clone bind: (Array
  187.             with: thing->#p1.y
  188.             with: thing->#p5.y
  189.             with: thing->#p2.y)
  190.          strength: #strongPreferred).
  191.     thing addConstraint:
  192.         (mp clone bind: (Array
  193.             with: thing->#p2.y
  194.             with: thing->#p6.y
  195.             with: thing->#p3.y)
  196.          strength: #strongPreferred).
  197.     thing addConstraint:
  198.         (mp clone bind: (Array
  199.             with: thing->#p3.y
  200.             with: thing->#p7.y
  201.             with: thing->#p4.y)
  202.          strength: #strongPreferred).
  203.     thing addConstraint:
  204.         (mp clone bind: (Array
  205.             with: thing->#p4.y
  206.             with: thing->#p8.y
  207.             with: thing->#p1.y)
  208.          strength: #strongPreferred).
  209.  
  210.     thing addConstraint:
  211.         (mp clone bind: (Array
  212.             with: thing->#p5.y
  213.             with: thing->#p10.y
  214.             with: thing->#p6.y)
  215.          strength: #strongPreferred).
  216.     thing addConstraint:
  217.         (mp clone bind: (Array
  218.             with: thing->#p6.y
  219.             with: thing->#p11.y
  220.             with: thing->#p7.y)
  221.          strength: #strongPreferred).
  222.     thing addConstraint:
  223.         (mp clone bind: (Array
  224.             with: thing->#p7.y
  225.             with: thing->#p12.y
  226.             with: thing->#p8.y)
  227.          strength: #strongPreferred).
  228.     thing addConstraint:
  229.         (mp clone bind: (Array
  230.             with: thing->#p8.y
  231.             with: thing->#p9.y
  232.             with: thing->#p5.y)
  233.          strength: #strongPreferred).
  234.  
  235.     thing addConstraint:
  236.         (mp clone bind: (Array
  237.             with: thing->#p9.y
  238.             with: thing->#p13.y
  239.             with: thing->#p10.y)
  240.          strength: #strongPreferred).
  241.     thing addConstraint:
  242.         (mp clone bind: (Array
  243.             with: thing->#p10.y
  244.             with: thing->#p14.y
  245.             with: thing->#p11.y)
  246.          strength: #strongPreferred).
  247.     thing addConstraint:
  248.         (mp clone bind: (Array
  249.             with: thing->#p11.y
  250.             with: thing->#p15.y
  251.             with: thing->#p12.y)
  252.          strength: #strongPreferred).
  253.     thing addConstraint:
  254.         (mp clone bind: (Array
  255.             with: thing->#p12.y
  256.             with: thing->#p16.y
  257.             with: thing->#p9.y)
  258.          strength: #strongPreferred).!
  259.  
  260. addStays
  261.     "Add 24 Stay constraints to keep things under control..."
  262.  
  263.     thing strongDefaultStay: #p1.x.
  264.     thing strongDefaultStay: #p2.x.
  265.     thing strongDefaultStay: #p3.x.
  266.     thing strongDefaultStay: #p4.x.
  267.     thing strongDefaultStay: #p1.y.
  268.     thing strongDefaultStay: #p2.y.
  269.     thing strongDefaultStay: #p3.y.
  270.     thing strongDefaultStay: #p4.y.
  271.     thing defaultStay: #p5.x.
  272.     thing defaultStay: #p6.x.
  273.     thing defaultStay: #p7.x.
  274.     thing defaultStay: #p8.x.
  275.     thing defaultStay: #p5.y.
  276.     thing defaultStay: #p6.y.
  277.     thing defaultStay: #p7.y.
  278.     thing defaultStay: #p8.y.
  279.     thing weakDefaultStay: #p9.x.
  280.     thing weakDefaultStay: #p10.x.
  281.     thing weakDefaultStay: #p11.x.
  282.     thing weakDefaultStay: #p12.x.
  283.     thing weakDefaultStay: #p9.y.
  284.     thing weakDefaultStay: #p10.y.
  285.     thing weakDefaultStay: #p11.y.
  286.     thing weakDefaultStay: #p12.y.!
  287.  
  288. buildThing
  289.     "Create an empty Thing and add sixteen lines and sixteen points."
  290.  
  291.     | parts |
  292.     thing _ Thing defineNewThing.
  293.     parts _ (1 to: 4) collect: [: i | PointThing new].
  294.     thing addPartsNamed: #(p1 p2 p3 p4) toHold: parts.
  295.     parts _ (1 to: 4) collect: [: i | PointThing new].
  296.     thing addPartsNamed: #(p5 p6 p7 p8) toHold: parts.
  297.     parts _ (1 to: 4) collect: [: i | PointThing new].
  298.     thing addPartsNamed: #(p9 p10 p11 p12) toHold: parts.
  299.     parts _ (1 to: 4) collect: [: i | PointThing new].
  300.     thing addPartsNamed: #(p13 p14 p15 p16) toHold: parts.
  301.  
  302.     parts _ (1 to: 4) collect: [: i | LineThing new].
  303.     thing addPartsNamed: #(l1 l2 l3 l4) toHold: parts.
  304.     parts _ (1 to: 4) collect: [: i | LineThing new].
  305.     thing addPartsNamed: #(l5 l6 l7 l8) toHold: parts.
  306.     parts _ (1 to: 4) collect: [: i | LineThing new].
  307.     thing addPartsNamed: #(l9 l10 l11 l12) toHold: parts.
  308.     parts _ (1 to: 4) collect: [: i | LineThing new].
  309.     thing addPartsNamed: #(l13 l14 l15 l16) toHold: parts.!
  310.  
  311. doMerges
  312.     "Connect-the-dots with merges..."
  313.  
  314.     thing merge: #l1.p1 with: #p1.
  315.     thing merge: #l1.p2 with: #p2.
  316.     thing merge: #l2.p1 with: #p2.
  317.     thing merge: #l2.p2 with: #p3.
  318.     thing merge: #l3.p1 with: #p3.
  319.     thing merge: #l3.p2 with: #p4.
  320.     thing merge: #l4.p1 with: #p4.
  321.     thing merge: #l4.p2 with: #p1.
  322.  
  323.     thing merge: #l5.p1 with: #p5.
  324.     thing merge: #l5.p2 with: #p6.
  325.     thing merge: #l6.p1 with: #p6.
  326.     thing merge: #l6.p2 with: #p7.
  327.     thing merge: #l7.p1 with: #p7.
  328.     thing merge: #l7.p2 with: #p8.
  329.     thing merge: #l8.p1 with: #p8.
  330.     thing merge: #l8.p2 with: #p5.
  331.  
  332.     thing merge: #l9.p1 with: #p9.
  333.     thing merge: #l9.p2 with: #p10.
  334.     thing merge: #l10.p1 with: #p10.
  335.     thing merge: #l10.p2 with: #p11.
  336.     thing merge: #l11.p1 with: #p11.
  337.     thing merge: #l11.p2 with: #p12.
  338.     thing merge: #l12.p1 with: #p12.
  339.     thing merge: #l12.p2 with: #p9.
  340.  
  341.     thing merge: #l13.p1 with: #p13.
  342.     thing merge: #l13.p2 with: #p14.
  343.     thing merge: #l14.p1 with: #p14.
  344.     thing merge: #l14.p2 with: #p15.
  345.     thing merge: #l15.p1 with: #p15.
  346.     thing merge: #l15.p2 with: #p16.
  347.     thing merge: #l16.p1 with: #p16.
  348.     thing merge: #l16.p2 with: #p13.!
  349.  
  350. initializeParts
  351.     "Initialize the outer four points and let constraints do the rest."
  352.  
  353.     thing set: #p1.x to: 20.
  354.     thing set: #p1.y to: 20.
  355.     thing set: #p2.x to: 20.
  356.     thing set: #p2.y to: 120.
  357.     thing set: #p3.x to: 150.
  358.     thing set: #p3.y to: 120.
  359.     thing set: #p4.x to: 150.
  360.     thing set: #p4.y to: 20.! !
  361. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  362.  
  363. QuadrilateralDemo class
  364.     instanceVariableNames: ''!
  365.  
  366.  
  367. MultiThingAdaptor subclass: #SortingDemo
  368.     instanceVariableNames: 'array seed '
  369.     classVariableNames: ''
  370.     poolDictionaries: ''
  371.     category: 'TLII-Demos'!
  372.  
  373.  
  374. !SortingDemo methodsFor: 'public'!
  375.  
  376. makeDemo: size
  377.     "SortingDemo new makeDemo: 5"
  378.  
  379.     self buildArray: size.
  380.     self buildButtons.
  381.     MultiThingView openOn: self.! !
  382.  
  383. !SortingDemo methodsFor: 'sorting'!
  384.  
  385. bubbleSort: aView
  386.  
  387.     | lower upper temp |
  388.     2 to: array size do:
  389.         [: i |
  390.          upper _ i.
  391.          lower _ upper - 1.
  392.          [(lower > 0) and:
  393.            [(array at: upper) extent x < (array at: lower) extent x]] whileTrue:
  394.             [self swap: (array at: upper) with: (array at: lower) in: aView.
  395.              temp _ array at: lower.
  396.              array at: lower put: (array at: upper).
  397.              array at: upper put: temp.
  398.              upper _ upper - 1.
  399.              lower _ upper - 1]].!
  400.  
  401. findPivotFrom: start to: stop
  402.     "Answer the index of the largest of the leftmost of the first two different keys or zero if all keys from start through stop are identical."
  403.  
  404.     | firstKey |
  405.     firstKey _ (array at: start) extent x .
  406.     (start + 1) to: stop do:
  407.         [: i |
  408.          ((array at: i) extent x > firstKey)
  409.             ifTrue: [^i]
  410.             ifFalse:
  411.                 [((array at: i) extent x < firstKey)
  412.                     ifTrue: [^start]]].
  413.     ^0    "all keys are the same"!
  414.  
  415. insertionSort: aView
  416.  
  417.     | i j bar1 bar2 |
  418.     2 to: array size do:
  419.         [: i |
  420.          j _ i.
  421.          [(j > 1) and:
  422.           [bar1 _ array at: j.
  423.            bar2 _ array at: j - 1.
  424.            bar2 extent x > bar1 extent x]] whileTrue:
  425.             [self swap: bar1 with: bar2 in: aView.
  426.              array at: j put: bar2.
  427.              array at: (j - 1) put: bar1.
  428.              j _ j - 1]].!
  429.  
  430. partitionBy: pivotKey from: start to: stop in: aView
  431.     "Partition the sub-array from start to stop using the given pivot key. After this operation, all elements whose keys are less than pivotKey will be to the left of those whose keys are the same or equal to pivotKey."
  432.  
  433.     | left right temp |
  434.     left _ start.
  435.     right _ stop.
  436.     [true] whileTrue:
  437.         ["scan left and right"
  438.          [(array at: left) extent x < pivotKey] whileTrue: [left _ left + 1].
  439.          [(array at: right) extent x >= pivotKey] whileTrue: [right _ right - 1].
  440.          (left > right) ifTrue:
  441.             ["partitioning complete"
  442.              ^left].
  443.          "swap"
  444.          self swap: (array at: left) with: (array at: right) in: aView.
  445.          temp _ array at: left.
  446.          array at: left put: (array at: right).
  447.          array at: right put: temp].!
  448.  
  449. quickSortFrom: start to: stop in: aView
  450.  
  451.     | pivotIndex pivotKey splitIndex |
  452.     pivotIndex _ self findPivotFrom: start to: stop.
  453.     (pivotIndex ~= 0) ifTrue:
  454.         ["do this only if there was more than one key"
  455.          pivotKey _ (array at: pivotIndex) extent x.
  456.          splitIndex _ self partitionBy: pivotKey from: start to: stop in: aView.
  457.          self quickSortFrom: start to: (splitIndex - 1) in: aView.
  458.          self quickSortFrom: splitIndex to: stop in: aView].!
  459.  
  460. selectionSort: aView
  461.  
  462.     | i j low lowKey temp |
  463.     1 to: array size - 1 do:
  464.         [: i |
  465.          low _ i.
  466.          lowKey _ (array at: i) extent x.
  467.          (i + 1) to: (array size) do:
  468.             [: j |
  469.              ((array at: j) extent x < lowKey) ifTrue:
  470.                 [low _ j.
  471.                  lowKey _ (array at: j) extent x]].
  472.         self swap: (array at: i) with: (array at: low) in: aView.
  473.         temp _ array at: i.
  474.         array at: i put: (array at: low).
  475.         array at: low put: temp].!
  476.  
  477. swap: bar1 with: bar2 in: aView
  478.  
  479.     | inputConstraints y1 y2 delta |
  480.     inputConstraints _ (Array
  481.         with: (EditConstraint ref: bar1->#center.y)
  482.         with: (EditConstraint ref: bar2->#center.y)).
  483.     aView controller addInputConstraints: inputConstraints.
  484.     aView controller makePlan.
  485.     y1 _ bar1 center y.
  486.     y2 _ bar2 center y.
  487.     delta _ (y2 - y1) // 6.
  488.     4 timesRepeat:
  489.         [bar1 center primy: (bar1 center y + delta).
  490.          bar2 center primy: (bar2 center y - delta).
  491.         aView controller executeAndRedisplay].
  492.     bar1 center primy: y2.
  493.     bar2 center primy: y1.
  494.     aView controller executeAndRedisplay.
  495.     aView controller removeInputConstraints: inputConstraints.! !
  496.  
  497. !SortingDemo methodsFor: 'other operations'!
  498.  
  499. randomize: aView
  500.  
  501.     seed _ Time millisecondClockValue.
  502.     self initializeBars.
  503.     aView displayScene.!
  504.  
  505. reset: aView
  506.  
  507.     self initializeBars.
  508.     aView displayScene.! !
  509.  
  510. !SortingDemo methodsFor: 'private'!
  511.  
  512. buildArray: count
  513.  
  514.     | center width bar |
  515.     center _ ((NodeMinusNodes new) preferStay: #value; primvalue: 180)->#value.
  516.     width _ ((NodeMinusNodes new) preferStay: #value; primvalue: 3)->#value.
  517.     array _ (1 to: count) collect:
  518.         [: i |
  519.          bar _ RectThing new.
  520.          bar set: #fillMask to: Form black.
  521.          EqualityConstraint require: bar->#center.x equals: center.
  522.          EqualityConstraint require: bar->#extent.y equals: width.
  523.          self addGlyph: bar.
  524.          bar].
  525.     seed _ Time millisecondClockValue.
  526.     self initializeBars.!
  527.  
  528. buildButtons
  529.  
  530.     self addGlyph: ((ButtonThingMinusNodes new)
  531.         set: #text.node.value to: ' Reset ';
  532.         set: #text.box.topLeft.x to: 20;
  533.         set: #text.box.topLeft.y to: 20;
  534.         set: #action to: [: view | view model reset: view]).
  535.     self addGlyph: ((ButtonThingMinusNodes new)
  536.         set: #text.node.value to: ' Bubble Sort ';
  537.         set: #text.box.topLeft.x to: 20;
  538.         set: #text.box.topLeft.y to: 40;
  539.         set: #action to: [: view | view model bubbleSort: view]).
  540.     self addGlyph: ((ButtonThingMinusNodes new)
  541.         set: #text.node.value to: ' Selection Sort ';
  542.         set: #text.box.topLeft.x to: 20;
  543.         set: #text.box.topLeft.y to: 60;
  544.         set: #action to: [: view | view model selectionSort: view]).
  545.     self addGlyph: ((ButtonThingMinusNodes new)
  546.         set: #text.node.value to: ' Insertion Sort ';
  547.         set: #text.box.topLeft.x to: 20;
  548.         set: #text.box.topLeft.y to: 80;
  549.         set: #action to: [: view | view model insertionSort: view]).
  550.     self addGlyph: ((ButtonThingMinusNodes new)
  551.         set: #text.node.value to: ' Quick Sort ';
  552.         set: #text.box.topLeft.x to: 20;
  553.         set: #text.box.topLeft.y to: 100;
  554.         set: #action to:
  555.             [: view | view model quickSortFrom: 1 to: array size in: view]).
  556.     self addGlyph: ((ButtonThingMinusNodes new)
  557.         set: #text.node.value to: ' Randomize ';
  558.         set: #text.box.topLeft.x to: 20;
  559.         set: #text.box.topLeft.y to: 120;
  560.         set: #action to: [: view | view model randomize: view]).!
  561.  
  562. initializeBars
  563.  
  564.     | bar random |
  565.     random _ Random fromGenerator: 1 seededWith: seed. 
  566.     1 to: array size do:
  567.         [: i |
  568.          bar _ array at: i.
  569.          bar set: #extent.x to: (4 + (2 * (random next * 50.0) rounded)).
  570.          bar set: #center.y to: 20 + (8 * i)]! !
  571. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  572.  
  573. SortingDemo class
  574.     instanceVariableNames: ''!
  575.  
  576.  
  577. Object subclass: #MusicDemo
  578.     instanceVariableNames: 'thing pitchC stemDirC timeC timeLocC '
  579.     classVariableNames: ''
  580.     poolDictionaries: ''
  581.     category: 'TLII-Demos'!
  582. MusicDemo comment:
  583. 'This demo shows how constraints may be used to handle a simple musical layout problem. Notes are related to each other temporally and their position is related to the time and pitch, within the context of a musical staff.'!
  584.  
  585.  
  586. !MusicDemo methodsFor: 'public'!
  587.  
  588. makeDemo
  589.     "MusicDemo new makeDemo"
  590.  
  591.     | treble bass firstNoteOfStaff lastNote |
  592.     self buildConstraints.
  593.     thing _ Thing defineNewThing.
  594.     treble _ self newTrebleStaffAt: 20@40 width: 370.
  595.     firstNoteOfStaff _ self newPitch: 67 type: #q staff: treble.
  596.     lastNote _ self addPitch: 71 type: #h after: firstNoteOfStaff staff: treble.
  597.     lastNote _ self addPitch: 69 type: #q after: lastNote staff: treble.
  598.     lastNote _ self addPitch: 71 type: #q after: lastNote staff: treble.
  599.     lastNote _ self addPitch: 72 type: #h after: lastNote staff: treble.
  600.     lastNote _ self addPitch: 74 type: #h after: lastNote staff: treble.
  601.     lastNote _ self addPitch: 74 type: #h after: lastNote staff: treble.
  602.     lastNote _ self addPitch: 72 type: #h after: lastNote staff: treble.
  603.     lastNote _ self addPitch: 71 type: #h after: lastNote staff: treble.
  604.     lastNote _ self addPitch: 69 type: #q after: lastNote staff: treble.
  605.     lastNote _ self addPitch: 71 type: #q after: lastNote staff: treble.
  606.  
  607.     firstNoteOfStaff set: #time to: 0.
  608.     bass _ self newBassStaffAt: 20@70 width: 370.
  609.     firstNoteOfStaff _ self newPitch: 47 type: #h staff: bass.
  610.     lastNote _ self addPitch: 59 type: #w after: firstNoteOfStaff staff: bass.
  611.     lastNote _ self addPitch: 59 type: #h after: lastNote staff: bass.
  612.     lastNote _ self addPitch: 59 type: #q after: lastNote staff: bass.
  613.     lastNote _ self addPitch: 59 type: #q after: lastNote staff: bass.
  614.     lastNote _ self addPitch: 59 type: #h after: lastNote staff: bass.
  615.     lastNote _ self addPitch: 59 type: #h after: lastNote staff: bass.
  616.     lastNote _ self addPitch: 59 type: #h after: lastNote staff: bass.
  617.     lastNote _ self addPitch: 59 type: #h after: lastNote staff: bass.
  618.     firstNoteOfStaff set: #time to: 0.
  619.     self destroyConstraints.
  620.     ThingConstructorView openOn: thing.! !
  621.  
  622. !MusicDemo methodsFor: 'private'!
  623.  
  624. addPitch: pitch type: aSymbol after: lastNote staff: staff
  625.  
  626.     | note |
  627.     note _ self newPitch: pitch type: aSymbol staff: staff.
  628.     thing addConstraint:
  629.         (timeC clone bind: (Array
  630.             with: lastNote->#time
  631.             with: lastNote->#duration
  632.             with: note->#time)
  633.         strength: #strongPreferred).
  634.     ^note!
  635.  
  636. buildConstraints
  637.     "Create prototype constraints."
  638.  
  639.     pitchC _ Constraint
  640.         symbols: #(staffY middleC pitch noteY)
  641.         methodStrings: #(
  642.             'noteY _ staffY + middleC - ((pitch - 60) * 2)'
  643.             'pitch _ 60 + (((staffY + middleC) - noteY) // 2)').
  644.     stemDirC _ Constraint
  645.         symbols: #(noteY staffY stemDir)
  646.         methodStrings: #(
  647.             'stemDir _ ((noteY - staffY) >= 10) ifTrue: [#up] ifFalse: [#down]').
  648.     timeC _ Constraint
  649.         symbols: #(lastStartTime lastDur startTime)
  650.         methodStrings: #(
  651.             'startTime _ lastStartTime + lastDur'
  652.             'lastStartTime _ startTime - lastDur').
  653.     timeLocC _ Constraint
  654.         symbols: #(staffX startTime noteX)
  655.         methodStrings: #(
  656.             'noteX _ staffX + 30 + (startTime // 3)'
  657.             'startTime _ (noteX - staffX - 30) * 3').!
  658.  
  659. destroyConstraints
  660.  
  661.     pitchC destroy.
  662.     stemDirC destroy.
  663.     timeC destroy.
  664.     timeLocC destroy.!
  665.  
  666. newBassStaffAt: aPoint width: width
  667.  
  668.     | staff |
  669.     staff _ BassClefThing new.
  670.     thing addThing: staff.
  671.     staff set: #location.x to: aPoint x.
  672.     staff set: #location.y to: aPoint y.
  673.     staff set: #width to: width.
  674.     ^staff!
  675.  
  676. newPitch: pitch type: aSymbol staff: staff
  677.  
  678.     | note |
  679.     note _ NoteThing new.
  680.     thing addThing: note.
  681.     note set: #pitch to: pitch.
  682.     note set: #time to: 0.
  683.     note set: #type to: (self symToType: aSymbol).
  684.     note defaultStay: #pitch.
  685.     note defaultStay: #time.
  686.     thing addConstraint:
  687.         (pitchC clone bind: (Array
  688.             with: staff->#location.y
  689.             with: staff->#middleCOffset
  690.             with: note->#pitch
  691.             with: note->#location.y)
  692.         strength: #required).
  693.     thing addConstraint:
  694.         (stemDirC clone bind: (Array
  695.             with: note->#location.y
  696.             with: staff->#location.y
  697.             with: note->#stemDirection)
  698.         strength: #required).
  699.     thing addConstraint:
  700.         (timeLocC clone bind: (Array
  701.             with: staff->#location.x
  702.             with: note->#time
  703.             with: note->#location.x)
  704.         strength: #required).
  705.     ^note!
  706.  
  707. newTrebleStaffAt: aPoint width: width
  708.  
  709.     | staff |
  710.     staff _ TrebleClefThing new.
  711.     thing addThing: staff.
  712.     staff set: #location.x to: aPoint x.
  713.     staff set: #location.y to: aPoint y.
  714.     staff set: #width to: width.
  715.     ^staff!
  716.  
  717. symToType: aSymbol
  718.  
  719.     (aSymbol == #s) ifTrue: [^1].
  720.     (aSymbol == #e) ifTrue: [^2].
  721.     (aSymbol == #q) ifTrue: [^3].
  722.     (aSymbol == #h) ifTrue: [^4].
  723.     (aSymbol == #w) ifTrue: [^5].
  724.     ^3    "default is quarter note"! !
  725. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  726.  
  727. MusicDemo class
  728.     instanceVariableNames: ''!
  729.  
  730.  
  731. Object subclass: #ChessBoardDemo
  732.     instanceVariableNames: 'thing '
  733.     classVariableNames: ''
  734.     poolDictionaries: ''
  735.     category: 'TLII-Demos'!
  736.  
  737.  
  738. !ChessBoardDemo methodsFor: 'public'!
  739.  
  740. makeDemo
  741.     "Note: This demo involves a large number of constraints (126 equality constraints and 256 internal rectangle constraints) so it is somewhat slower than most of the other demos. Because all the constraints are interconnected, the entire constraint graph is traversed when any point is moved with the mouse."
  742.     "ChessBoardDemo new makeDemo"
  743.  
  744.     self buildThing.
  745.     self addLayoutConstraints.
  746.     ThingConstructorView openOn: thing.! !
  747.  
  748. !ChessBoardDemo methodsFor: 'private'!
  749.  
  750. addLayoutConstraints
  751.     "Add the layout constraints to 'glue' the squares together. While we're at it, make the square colors alternate."
  752.  
  753.     | black previousSquare square |
  754.     black _ true.
  755.     1 to: 8 do:
  756.         [: row |
  757.          previousSquare _ nil.
  758.          black _ black not.
  759.          1 to: 8 do:
  760.             [: col |
  761.              square _ thing perform:
  762.                 (('r', row printString, 'c', col printString) asSymbol).
  763.              square set: #fillRule to: (Form over).
  764.              square set: #fillMask to:
  765.                 ((black) ifTrue: [Form black] ifFalse: [Form lightGray]).
  766.              (previousSquare isNil)
  767.                 ifTrue:
  768.                     ["this is the first square of a new row"
  769.                      square offset: #bottomRight.y by: 25 from: #topLeft.y]
  770.                 ifFalse:
  771.                     ["link to the previous square in this row"
  772.                      EqualityConstraint
  773.                         require: square->#topLeft.y
  774.                         equals: previousSquare->#topLeft.y.
  775.                       EqualityConstraint
  776.                         require: square->#bottomRight.y
  777.                         equals: previousSquare->#bottomRight.y].
  778.              black _ black not.    "toggle color of next square"
  779.              previousSquare _ square]].
  780.  
  781.     1 to: 8 do:
  782.         [: col |
  783.          previousSquare _ nil.
  784.          1 to: 8 do:
  785.             [: row |
  786.              square _ thing perform:
  787.                 (('r', row printString, 'c', col printString) asSymbol).
  788.              (previousSquare isNil)
  789.                 ifTrue:
  790.                     ["this is the first square of a new column"
  791.                      square offset: #bottomRight.x by: 25 from: #topLeft.x]
  792.                 ifFalse:
  793.                     ["link to the previous square in this column"
  794.                      EqualityConstraint
  795.                         require: square->#topLeft.x
  796.                         equals: previousSquare->#topLeft.x.
  797.                      EqualityConstraint
  798.                         require: square->#bottomRight.x
  799.                         equals: previousSquare->#bottomRight.x].
  800.              previousSquare _ square]].
  801.  
  802.     previousSquare _ thing perform: #r1c1.
  803.     2 to: 8 do:
  804.         [: i |
  805.          square _ thing perform: (('r', i printString, 'c', i printString) asSymbol).
  806.          EqualityConstraint
  807.             require: previousSquare->#bottomRight.x
  808.             equals: square->#topLeft.x.
  809.          EqualityConstraint
  810.             require: previousSquare->#bottomRight.y
  811.             equals: square->#topLeft.y.
  812.          previousSquare _ square].
  813.  
  814.     "position the board as a whole"
  815.     thing set: #r1c1.topLeft.x to: 30.
  816.     thing set: #r1c1.topLeft.y to: 30.!
  817.  
  818. buildThing
  819.     "Construct a chess board from 64 sqare rectangles labeled 'r1c1 through 'r8c8'."
  820.  
  821.     | names squares |
  822.     thing _ Thing defineNewThing.
  823.     names _ OrderedCollection new.
  824.     squares _ OrderedCollection new.
  825.  
  826.     "first, build a list of square names and squares to add..."
  827.     1 to: 8 do:
  828.         [: row |
  829.          1 to: 8 do:
  830.             [: col |
  831.              names add: ('r', row printString, 'c', col printString) asSymbol.
  832.              squares add:
  833.                 (SimpleRectThing new
  834.                     set: #extent.x to: 25;
  835.                     set: #extent.y to: 25)]].
  836.  
  837.     "then, add them"
  838.     thing addPartsNamed: names toHold: squares.! !
  839. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  840.  
  841. ChessBoardDemo class
  842.     instanceVariableNames: ''!
  843.  
  844.  
  845. Object subclass: #BrowserDemo
  846.     instanceVariableNames: 'thing '
  847.     classVariableNames: ''
  848.     poolDictionaries: ''
  849.     category: 'TLII-Demos'!
  850.  
  851.  
  852. !BrowserDemo methodsFor: 'public'!
  853.  
  854. makeDemo
  855.     "BrowserDemo new makeDemo"
  856.  
  857.     thing _ Thing defineNewThing.
  858.     thing addPartsNamed: #(pane1 pane2 pane3 pane4 methodPane) toHold:
  859.         (Array
  860.             with: ScrollingListThingMinusNodes new
  861.             with: ScrollingListThingMinusNodes new
  862.             with: ScrollingListThingMinusNodes new
  863.             with: ScrollingListThingMinusNodes new),
  864.         (Array
  865.             with: ParagraphThingMinusNodes new).
  866.  
  867.     self addLayoutConstraints.
  868.     self doInitialPlacement.
  869.     self addPaneToPaneConstraints.
  870.     thing set: #pane1.itemsList.value to: (SystemOrganization categories).
  871.     ThingConstructorView openOn: thing.! !
  872.  
  873. !BrowserDemo methodsFor: 'private'!
  874.  
  875. addLayoutConstraints
  876.  
  877.     thing require: #pane1.box.topLeft.y
  878.           equals: #pane2.box.topLeft.y.
  879.     thing require: #pane1.box.bottomRight.y
  880.           equals: #pane2.box.bottomRight.y.
  881.     thing require: #pane1.box.bottomRight.x
  882.           equals: #pane2.scrollBar.box.topLeft.x.
  883.  
  884.     thing require: #pane3.box.topLeft.y
  885.           equals: #pane4.box.topLeft.y.
  886.     thing require: #pane3.box.bottomRight.y
  887.           equals: #pane4.box.bottomRight.y.
  888.     thing require: #pane3.box.bottomRight.x
  889.           equals: #pane4.scrollBar.box.topLeft.x.
  890.  
  891.     thing require: #pane1.box.bottomRight.y
  892.           equals: #pane3.box.topLeft.y.
  893.     thing require: #pane1.box.topLeft.x
  894.           equals: #pane3.box.topLeft.x.
  895.  
  896.     thing require: #pane2.box.topLeft.x
  897.           equals: #pane4.box.topLeft.x.
  898.     thing require: #pane2.box.bottomRight.x
  899.           equals: #pane4.box.bottomRight.x.
  900.  
  901.     thing require: #pane3.scrollBar.box.topLeft.x
  902.           equals: #methodPane.box.topLeft.x.
  903.     thing require: #pane4.box.bottomRight.x
  904.           equals: #methodPane.box.bottomRight.x.
  905.     thing require: #pane4.box.bottomRight.y
  906.           equals: #methodPane.box.topLeft.y.!
  907.  
  908. addPaneToPaneConstraints
  909.  
  910.     "if a class category is selected, comute its class list"
  911.     thing methods: #(
  912.             'classes _ (classCat isNil)
  913.                 ifTrue: [#()]
  914.                 ifFalse: [SystemOrganization listAtCategoryNamed: classCat]')
  915.         where: #(
  916.             (classCat pane1.selectedItem.value)
  917.             (classes pane2.itemsList.value))
  918.         strength: #preferred.
  919.  
  920.     "if a class is selected, compute its message categories
  921.      otherwise, the message categories list is empty"
  922.     thing methods: #(
  923.             'methodCats _ (className isNil)
  924.                 ifTrue: [#()]
  925.                 ifFalse: [(Smalltalk at: className) organization categories]')
  926.         where: #(
  927.             (className pane2.selectedItem.value)
  928.             (methodCats pane3.itemsList.value))
  929.          strength: #preferred.
  930.  
  931.     "if a class and method category are selected, compute the message list
  932.      otherwise, the message list is empty"
  933.     thing methods: #(
  934.             'methods _ (className isNil | methodCat isNil)
  935.                 ifTrue: [#()]
  936.                 ifFalse: [(Smalltalk at: className) organization
  937.                             listAtCategoryNamed: methodCat]')
  938.         where: #(
  939.             (className pane2.selectedItem.value)
  940.             (methodCat pane3.selectedItem.value)
  941.             (methods pane4.itemsList.value))
  942.         strength: #preferred.
  943.  
  944.     "if a class and method are selected, get the method text
  945.      otherwise, the method pane is empty"
  946.     thing methods: #(
  947.             'methodText _ (className isNil | methodName isNil)
  948.                 ifTrue: ['''']
  949.                 ifFalse:
  950.                     [((className = oldClassName) &
  951.                      (methodName = oldMethodName))
  952.                         ifTrue: [oldMethodText]
  953.                         ifFalse:
  954.                             [(Smalltalk at: className)
  955.                                 sourceCodeAt: methodName]]')
  956.         where: #(
  957.             (className pane2.selectedItem.value)
  958.             (oldClassName pane2.selectedItem.last)
  959.             (methodName pane4.selectedItem.value)
  960.             (oldMethodName pane4.selectedItem.last)
  961.             (methodText methodPane.node.value)
  962.             (oldMethodText methodPane.node.last))
  963.         strength: #preferred.!
  964.  
  965. doInitialPlacement
  966.  
  967.     thing set: #pane1.scrollBar.box.topLeft.x to: 20.    "left"
  968.     thing set: #pane2.scrollBar.box.topLeft.x to: 220.    "middle"
  969.     thing set: #pane2.box.bottomRight.x to: 420.        "right"
  970.  
  971.     thing set: #pane1.scrollBar.box.topLeft.y to: 20.    "top"
  972.     thing set: #pane3.scrollBar.box.topLeft.y to: 85.    "middle"
  973.     thing set: #methodPane.box.topLeft.y to: 150.    "top of method pane"
  974.     thing set: #methodPane.box.bottomRight.y to: 320. "bottom of method pane"! !
  975.  
  976. Object subclass: #TableDemo
  977.     instanceVariableNames: 'thing columnIndex lastColumnIndex lastColumnEdge '
  978.     classVariableNames: ''
  979.     poolDictionaries: ''
  980.     category: 'TLII-Demos'!
  981. TableDemo comment:
  982. 'This example shows how constraints may be used to build the graphical skeleton of a simple table using horizontal and vertical lines and TextThings. Try changing one of the column labels by selecting it and typing (be patient, there are lots of constraints to solve).'!
  983.  
  984.  
  985. !TableDemo methodsFor: 'public'!
  986.  
  987. makeDemo
  988.     "TableDemo new makeDemo"
  989.  
  990.     self basicOutline.
  991.     #(apples oranges frobitzes) do:
  992.         [: heading |
  993.          self addColumnNamed: heading asString lastColumn: false].
  994.     self addColumnNamed: 'total' lastColumn: true.
  995.  
  996.     ThingConstructorView openOn: thing.! !
  997.  
  998. !TableDemo methodsFor: 'private'!
  999.  
  1000. addColumnNamed: aString lastColumn: lastColumnFlag
  1001.  
  1002.     | header divider |
  1003.     columnIndex _ columnIndex + 1.
  1004.     header _ ('header', columnIndex printString) asSymbol.
  1005.     thing addPartsNamed: (Array with: header)
  1006.           toHold: (Array with: (TextThing newWith: ' ', aString, ' ')).
  1007.     thing require: (header, '.box.topLeft.x') asSymbol
  1008.           equals: (lastColumnEdge, '.p1.x') asSymbol.
  1009.     thing require: (header, '.box.topLeft.y') asSymbol equals: #top.p1.y.
  1010.     lastColumnFlag
  1011.         ifTrue:
  1012.             [thing require: (header, '.box.bottomRight.x') asSymbol
  1013.                    equals: #right.p1.x]
  1014.         ifFalse:
  1015.             [divider _ ('columnDivider', columnIndex printString) asSymbol.
  1016.              thing addPartsNamed: (Array with: divider)
  1017.                    toHold: (Array with: VLine new).
  1018.              thing require: (header, '.box.bottomRight.x') asSymbol
  1019.                   equals: (divider, '.p1.x') asSymbol.
  1020.              thing require: ((divider, '.p1.y') asSymbol) equals: #left.p1.y.
  1021.              thing require: ((divider, '.p2.y') asSymbol) equals: #left.p2.y.
  1022.              lastColumnEdge _ divider].!
  1023.  
  1024. basicOutline
  1025.     "Make the basic outline of the table."
  1026.  
  1027.     thing _ Thing defineNewThing.
  1028.     thing addPartsNamed: #(left right)
  1029.             toHold: (Array
  1030.                 with: (VLine new)
  1031.                 with: (VLine new)).
  1032.     thing addPartsNamed: #(top divider bottom)
  1033.             toHold: (Array
  1034.                 with: (HLine new)
  1035.                 with: (HLine new)
  1036.                 with: (HLine new)).
  1037.  
  1038.     thing merge: #left.p1 with: #top.p1.
  1039.     thing merge: #right.p1 with: #top.p2.
  1040.     thing merge: #left.p2 with: #bottom.p1.
  1041.     thing merge: #right.p2 with: #bottom.p2.
  1042.  
  1043.     thing require: #top.p1.x equals: #divider.p1.x.
  1044.     thing require: #top.p2.x equals: #divider.p2.x.
  1045.     thing offset: #divider.p1.y by: 15 from: #top.p1.y.
  1046.     thing defaultStay: #top.p1.x.
  1047.     thing defaultStay: #top.p1.y.
  1048.  
  1049.     thing set: #top.p1.x to: 20.
  1050.     thing set: #top.p1.y to: 20.
  1051.     thing set: #bottom.p1.x to: 20.
  1052.     thing set: #bottom.p1.y to: 120.
  1053.  
  1054.     columnIndex _ 0.
  1055.     lastColumnEdge _ #left.! !
  1056. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1057.  
  1058. TableDemo class
  1059.     instanceVariableNames: ''!
  1060.  
  1061.  
  1062. Object subclass: #OrbitDemo
  1063.     instanceVariableNames: 'thing '
  1064.     classVariableNames: ''
  1065.     poolDictionaries: ''
  1066.     category: 'TLII-Demos'!
  1067.  
  1068.  
  1069. !OrbitDemo methodsFor: 'public'!
  1070.  
  1071. makeDemo
  1072.     "OrbitDemo new makeDemo"
  1073.  
  1074.     thing _ Thing defineNewThing.
  1075.     thing addPartsNamed: #(orbit radius rate)
  1076.               toHold: (Array
  1077.                 with: OrbitThing new
  1078.                 with: VSliderThingMinusNodes new
  1079.                 with: VSliderThingMinusNodes new).
  1080.  
  1081.     thing require: #orbit.radius.node.value equals: #radius.node.value.
  1082.     thing require: #orbit.rate.node.value equals: #rate.node.value.
  1083.  
  1084.     thing set: #radius.node.location.x to: 67.
  1085.     thing set: #radius.node.location.y to: 55.
  1086.     thing set: #radius.minVal to: 0.0.
  1087.     thing set: #radius.maxVal to: 100.0.
  1088.  
  1089.     thing set: #rate.node.location.x to: 82.
  1090.     thing set: #rate.node.location.y to: 55.
  1091.     thing set: #rate.minVal to: 0.0.
  1092.     thing set: #rate.maxVal to: 60.0.
  1093.  
  1094.     thing set: #orbit.center.x to: 100.
  1095.     thing set: #orbit.center.y to: 100.
  1096.  
  1097.     ThingConstructorView openOn: thing.! !
  1098. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1099.  
  1100. OrbitDemo class
  1101.     instanceVariableNames: ''!
  1102.  
  1103.  
  1104. Object subclass: #TreeDemo
  1105.     instanceVariableNames: 'thing aboveC belowC leafWidthC leftXLocationC rightXLocationC widthC yLocationC '
  1106.     classVariableNames: ''
  1107.     poolDictionaries: ''
  1108.     category: 'TLII-Demos'!
  1109.  
  1110.  
  1111. !TreeDemo methodsFor: 'public'!
  1112.  
  1113. makeDemo
  1114.     "TreeDemo new makeDemo"
  1115.  
  1116.     self buildConstraints.
  1117.     self buildThing.
  1118.     self addConstraints.
  1119.     self destroyConstraints.
  1120.  
  1121.     ThingConstructorView openOn: thing.! !
  1122.  
  1123. !TreeDemo methodsFor: 'private'!
  1124.  
  1125. addConstraints
  1126.  
  1127.     self addLeafConstraint: 'n4'.
  1128.     self addLeafConstraint: 'n5'.
  1129.     self addLeafConstraint: 'n6'.
  1130.     self addLeafConstraint: 'n7'.
  1131.     self addWidthConstraint: 'n3' left: 'n6' right: 'n7'.
  1132.     self addWidthConstraint: 'n2' left: 'n4' right: 'n5'.
  1133.     self addWidthConstraint: 'n1' left: 'n2' right: 'n3'.
  1134.     self addRootConstraints: 'n1'.
  1135.     self addLocationConstraints: 'n1' left: 'n2' right: 'n3'.
  1136.     self addLocationConstraints: 'n2' left: 'n4' right: 'n5'.
  1137.     self addLocationConstraints: 'n3' left: 'n6' right: 'n7'.!
  1138.  
  1139. addLeafConstraint: leaf
  1140.  
  1141.     (leafWidthC clone
  1142.         bind: (Array
  1143.             with: thing->(leaf, '.width') asSymbol
  1144.             with: thing->(leaf, '.text.node.value') asSymbol)
  1145.         strength: #required) addConstraint.!
  1146.  
  1147. addLocationConstraints: parent left: left right: right
  1148.  
  1149.     (leftXLocationC clone
  1150.         bind: (Array
  1151.             with: thing->(left, '.text.box.center.x') asSymbol
  1152.             with: thing->(parent, '.text.box.center.x') asSymbol
  1153.             with: thing->(parent, '.width') asSymbol)
  1154.         strength: #required) addConstraint.
  1155.  
  1156.     (yLocationC clone
  1157.         bind: (Array
  1158.             with: thing->(left, '.text.box.center.y') asSymbol
  1159.             with: thing->(parent, '.text.box.center.y') asSymbol)
  1160.         strength: #required) addConstraint.
  1161.  
  1162.     (rightXLocationC clone
  1163.         bind: (Array
  1164.             with: thing->(right, '.text.box.center.x') asSymbol
  1165.             with: thing->(parent, '.text.box.center.x') asSymbol
  1166.             with: thing->(parent, '.width') asSymbol)
  1167.         strength: #required) addConstraint.
  1168.  
  1169.     (yLocationC clone
  1170.         bind: (Array
  1171.             with: thing->(right, '.text.box.center.y') asSymbol
  1172.             with: thing->(parent, '.text.box.center.y') asSymbol)
  1173.         strength: #required) addConstraint.!
  1174.  
  1175. addRootConstraints: root
  1176.  
  1177.     thing set: #n1.text.box.center.x to: 100.
  1178.     thing set: #n1.text.box.center.y to: 30.
  1179.     thing defaultStay: #n1.text.box.center.x.
  1180.     thing defaultStay: #n1.text.box.center.y.!
  1181.  
  1182. addWidthConstraint: parent left: left right: right
  1183.  
  1184.     | lineThing |
  1185.     (widthC clone
  1186.         bind: (Array
  1187.             with: thing->(parent, '.width') asSymbol
  1188.             with: thing->(parent, '.text.node.value') asSymbol
  1189.             with: thing->(left, '.width') asSymbol
  1190.             with: thing->(right, '.width') asSymbol)
  1191.         strength: #required) addConstraint.
  1192.  
  1193.     (Array with: left with: right) do:
  1194.         [: child |
  1195.          lineThing _ PlainLine new.
  1196.          thing addThing: lineThing.
  1197.          (EqualityConstraint
  1198.             ref: thing->(parent, '.text.box.center.x') asSymbol
  1199.             ref: lineThing->#p1.x
  1200.             strength: #required) addConstraint.
  1201.          (aboveC clone
  1202.             bind: (Array
  1203.                 with: thing->(parent, '.text.box.center.y') asSymbol
  1204.                 with: lineThing->#p1.y)
  1205.             strength: #required) addConstraint.
  1206.          (EqualityConstraint
  1207.             ref: lineThing->#p2.x
  1208.             ref: thing->(child, '.text.box.center.x') asSymbol
  1209.                 strength: #required) addConstraint.
  1210.         (aboveC clone
  1211.             bind: (Array
  1212.                 with: lineThing->#p2.y
  1213.                 with: thing->(child, '.text.box.center.y') asSymbol)
  1214.             strength: #required) addConstraint].!
  1215.  
  1216. buildConstraints
  1217.     "Create prototype constraints."
  1218.  
  1219.     widthC _ (Constraint
  1220.         symbols: #(width text leftWidth rightWidth)
  1221.         methodStrings: #(
  1222.             'width _ ((text asParagraph asForm extent x) + 16)
  1223.                 max: ((leftWidth max: rightWidth) * 2)')).
  1224.     leafWidthC _ (Constraint
  1225.         symbols: #(width text)
  1226.         methodStrings: #(
  1227.             'width _ (text asParagraph asForm extent x) + 16')).
  1228.     leftXLocationC _ (Constraint
  1229.         symbols: #(x parentX parentWidth)
  1230.         methodStrings: #(
  1231.             'x _ (parentX - (parentWidth // 4))'
  1232.             'parentX _ x + (parentWidth // 4)')).
  1233.     rightXLocationC _ (Constraint
  1234.         symbols: #(x parentX parentWidth)
  1235.         methodStrings: #(
  1236.             'x _ parentX + (parentWidth // 4)'
  1237.             'parentX _ x - (parentWidth // 4)')).
  1238.     yLocationC _ (Constraint
  1239.         symbols: #(y parentY)
  1240.         equation: 'y = (parentY + 40)').
  1241.     aboveC _ (Constraint
  1242.         symbols: #(topY bottomY)
  1243.         equation: 'bottomY = (topY + 10)').!
  1244.  
  1245. buildThing
  1246.  
  1247.     thing _ Thing defineNewThing.
  1248.     thing addPartsNamed: #(n1 n2 n3 n4 n5 n6 n7)
  1249.             toHold: ((1 to: 7) collect: [: i | TreeNodeThing new]).!
  1250.  
  1251. destroyConstraints
  1252.  
  1253.     aboveC destroy.
  1254.     belowC destroy.
  1255.     leafWidthC destroy.
  1256.     leftXLocationC destroy.
  1257.     rightXLocationC destroy.
  1258.     widthC destroy.
  1259.     yLocationC destroy.! !
  1260. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1261.  
  1262. TreeDemo class
  1263.     instanceVariableNames: ''!
  1264.  
  1265.  
  1266. Object subclass: #ScopeDemo
  1267.     instanceVariableNames: 'thing '
  1268.     classVariableNames: ''
  1269.     poolDictionaries: ''
  1270.     category: 'TLII-Demos'!
  1271.  
  1272.  
  1273. !ScopeDemo methodsFor: 'public'!
  1274.  
  1275. makeDemo
  1276.     "ScopeDemo new makeDemo"
  1277.  
  1278.     thing _ Thing defineNewThing.
  1279.     thing addPartsNamed: #(scope yScaleSlider yOffsetSlider yScalePrinter yOffsetPrinter)
  1280.             toHold:
  1281.                (Array
  1282.                 with: PenRecorderThing new
  1283.                 with: VSliderThingMinusNodes new
  1284.                 with: VSliderThingMinusNodes new),
  1285.                (Array
  1286.                 with: NumberDisplayer new
  1287.                 with: NumberDisplayer new).
  1288.  
  1289.     self initializeValues.
  1290.     self addConstraints.
  1291.     self initializeValues.
  1292.     self addVisibilityMethod.
  1293.     self addSelectabilityMethod.
  1294.  
  1295.      ThingConstructorView openOn: thing.! !
  1296.  
  1297. !ScopeDemo methodsFor: 'private'!
  1298.  
  1299. addConstraints
  1300.  
  1301.     thing require: #yScalePrinter.node.value equals: #scope.scale.value.
  1302.     thing require: #yOffsetPrinter.node.value equals: #scope.offset.value.
  1303.  
  1304.     thing require: '(10.0 raisedTo: sliderVal) = yScale'
  1305.          where: #((sliderVal yScaleSlider.node.value) (yScale scope.scale.value)).
  1306.     thing require: #yOffsetSlider.node.value equals: #scope.offset.value.
  1307.  
  1308.     "layout"
  1309.     thing offset: #yScalePrinter.node.location.x by: 0
  1310.           from: #yScaleSlider.node.location.x.
  1311.     thing offset: #yScalePrinter.node.location.y by: 15
  1312.           from: #yScaleSlider.node.location.y.
  1313.     thing offset: #yOffsetPrinter.node.location.x by: 0
  1314.           from: #yOffsetSlider.node.location.x.
  1315.     thing offset: #yOffsetPrinter.node.location.y by: 15
  1316.           from: #yOffsetSlider.node.location.y.!
  1317.  
  1318. addSelectabilityMethod
  1319.  
  1320.     thing class compile:
  1321. 'selectableGlyphsInto: aSet
  1322.  
  1323.     aSet add: yScalePrinter.
  1324.     aSet add: yOffsetPrinter.
  1325.     scope selectableGlyphsInto: aSet'
  1326.         classified: 'glyphs'
  1327.         notifying: nil.!
  1328.  
  1329. addVisibilityMethod
  1330.  
  1331.     thing class
  1332.         compile: '
  1333. visibleGlyphsInto: aSet
  1334.  
  1335.     aSet add: yScaleSlider; add: yScaleSlider box.
  1336.     aSet add: yOffsetSlider; add: yOffsetSlider box.
  1337.     aSet add: yScalePrinter; add: yScalePrinter box.
  1338.     aSet add: yOffsetPrinter; add: yOffsetPrinter box.
  1339.     scope visibleGlyphsInto: aSet'
  1340.         classified: 'glyphs'
  1341.         notifying: nil.!
  1342.  
  1343. initializeValues
  1344.  
  1345.     thing set: #yScaleSlider.box.extent.x to: 12.
  1346.     thing set: #yScaleSlider.box.extent.y to: 80.
  1347.     thing set: #yScaleSlider.node.location.x to: 180.
  1348.     thing set: #yScaleSlider.node.location.y to: 100.
  1349.     thing set: #yScaleSlider.minVal to: -1.0.
  1350.     thing set: #yScaleSlider.maxVal to: 1.0.
  1351.  
  1352.     thing set: #yOffsetSlider.box.extent.x to: 12.
  1353.     thing set: #yOffsetSlider.box.extent.y to: 80.
  1354.     thing set: #yOffsetSlider.node.location.x to: 130.
  1355.     thing set: #yOffsetSlider.node.location.y to: 100.
  1356.     thing set: #yOffsetSlider.minVal to: -200.0.
  1357.     thing set: #yOffsetSlider.maxVal to: 200.0.
  1358.  
  1359.     thing set: #scope.scale.value to: 1.0.
  1360.     thing set: #yScalePrinter.node.value to: 1.0.
  1361.     thing set: #yScaleSlider.node.value to: 0.0.! !
  1362. "-- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- -- "!
  1363.  
  1364. ScopeDemo class
  1365.     instanceVariableNames: ''!
  1366.